home *** CD-ROM | disk | FTP | other *** search
/ Mastering Internet Develo…oft ActiveX Technologies / Mastering Internet Development with ActiveX (1996)(Microsoft).iso / labs / lab06 / olesvr / response.cls < prev   
Text File  |  1996-07-16  |  3KB  |  108 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "Products"
  6. Attribute VB_Creatable = True
  7. Attribute VB_Exposed = True
  8. Function CreateResponse(request As String) As String
  9.     Dim HTMLResponse As String
  10.     
  11.     WriteHeader HTMLResponse
  12.     WriteOrderConfirmTable request, HTMLResponse
  13.     WriteFooter HTMLResponse
  14.     
  15.     CreateResponse = HTMLResponse
  16. End Function
  17. Sub WriteHeader(HTMLResponse As String)
  18.     HTMLResponse = "Content-Type: text/html" & vbCrLf & vbCrLf _
  19.         & "<HTML><BODY><h3>Thank you for your order: </h3>"
  20. End Sub
  21. Sub WriteFooter(HTMLResponse As String)
  22.     HTMLResponse = HTMLResponse & "</BODY> </HTML>"
  23. End Sub
  24.  
  25. Sub WriteOrderConfirmTable(request As String, HTMLResponse As String)
  26.     Dim sSubTotal As Single
  27.     Dim sTax As Single
  28.     Dim NameValue As String
  29.     Dim iThisAnd As Integer, iNextAnd As Integer
  30.     Dim iEqualPos As Integer
  31.     Dim sql As String
  32.     Dim db As Database
  33.     Dim rs As Recordset
  34.     
  35.     WriteTableHeadings HTMLResponse
  36.     
  37.     'open NorthWind database...need to look up item names and prices
  38.     'use location on Internet server
  39.     Set db = OpenDatabase("c:\MID\Labs\MainSt.mdb")
  40.     
  41.     'parse request looking for items that are being ordered: productID=quantity
  42.     iThisAnd = 1
  43.     iNextAnd = InStr(request, "&")
  44.     'the last entry in the param list is the button
  45.     'used to invoke this OLE server...so we don't need it
  46.     Do Until iNextAnd = 0
  47.         NameValue = Mid(request, iThisAnd, iNextAnd - iThisAnd)
  48.         iEqualPos = InStr(NameValue, "=")
  49.         Name = Left(NameValue, iEqualPos - 1)
  50.         Value = Right(NameValue, Len(NameValue) - iEqualPos)
  51.         
  52.         'add item to summary table if a quantity was entered
  53.         If Value <> "0" Then
  54.             'get item information out of database
  55.             sql = "Select productName, unitprice from products where productID = " & Name
  56.             Set rs = db.OpenRecordset(sql, dbOpenSnapshot)
  57.             
  58.             'create table of ordered items
  59.             'TODO: unitprice needs to be formatted
  60.             HTMLResponse = HTMLResponse & _
  61.                 "<TR><TD>" & Value & _
  62.                 "</TD><TD>" & rs.Fields("ProductName") & _
  63.                 "</TD><TD>" & rs.Fields("Unitprice") & _
  64.                 "</TD></TR>"
  65.         
  66.             'keep track of subtotal
  67.             sSubTotal = sSubTotal + (Value * rs.Fields("Unitprice"))
  68.             
  69.             'close the recordset
  70.             rs.Close
  71.         End If
  72.         
  73.         'look for next &
  74.         iThisAnd = iNextAnd + 1
  75.         iNextAnd = InStr(iThisAnd, request, "&")
  76.     Loop
  77.     sTax = sSubTotal * 0.0825
  78.     
  79.     'add subtotal, tax, total
  80.     'TODO: format Sub, Tax and Total as currency
  81.     HTMLResponse = HTMLResponse & _
  82.         "<TR><TD colspan=2 align=right>Sub Total: </TD><TD>" & _
  83.         sSubTotal & "</TD></TR>" & _
  84.         "<TD colspan=2 align=right>Tax: </TD><TD>" & _
  85.         sTax & "</TD></TR>" & _
  86.         "<TD colspan=2 align=right>Total: </TD><TD>" & _
  87.         sSubTotal + sTax & "</TD></TR>"
  88.                 
  89.     'end table
  90.     HTMLResponse = HTMLResponse & "</TABLE>"
  91.     
  92.     'close the database
  93.     db.Close
  94.  
  95. End Sub
  96.  
  97. Sub Post(request As String, response As String)
  98.     response = CreateResponse(request)
  99. End Sub
  100.  
  101.  
  102. Sub WriteTableHeadings(HTML As String)
  103.     HTML = HTML & "<Table border=1 rules=rows> "
  104. End Sub
  105.  
  106.  
  107.  
  108.